Problem: RIV
(CEOI, Polonia, iulie 1997)
Traversarea raului

Cetatenii din Byteland adora sporturile in care gandirea logica este la fel de 
importanta ca si pregatirea fizica. Unul din aceste sporturi este traversarea 
lui Hex River, cel mai mare rau din Byteland. Exista n stalpi, numerotati cu 
1,..,n (de la stanga la dreapta), asezati intre cele doua maluri. 
Cetatenii trebuie sa traverseze raul sarind de pe malul stang pe un stalp, apoi 
pe un altul pana cand ajung pe malul drept. Malul stang este localizat ca fiind 
la stanga stalpului 1, iar malul drept - la dreapta celui de al n-lea stalp.

La momentul 0 cetateanul este pe malul stang si vrea sa ajunga pe malul drept 
cat mai repede posibil. La fiecare moment fiecare stalp este sus (deasupra apei) 
sau jos (sub apa), iar cetateanul se afla sau pe un mal sau pe un stalp. 
Cetateanul poate sta pe un stalp doar daca acesta este sus; un astfel de stalp 
se numeste 'accesibil'.

Fiecare stalp este jos la momentul 0, apoi sta sus a unitati de timp, jos b 
unitati de timp, sus a unitati de timp, s.a.m.d. Constantele a si b sunt definite 
separat pentru fiecare stalp. De exemplu, stalpul cu a=2 si b=3 va fi jos la 
momentul 0, sus la momentele 1 si 2, jos la momentele 3,4,5, s.a.m.d.

Traversarea incepe la momentul 0. La momentul t+1 un cetatean poate: 
- ramane pe loc (pe un stalp sau pe mal)
- sari pe un stalp accesibil situat pana la 5 stalpi departare de pozitia sa 
initiala (cea de la momentul t);
- sari pe un mal, daca pana la acesta exista cel mult 4 stalpi. De exemplu, de 
la stalpul 5 se poate ajunge pe malul stang sau pe oricare din stalpii 
1,2,3,4,5,6,7,8,9,10.

Problema:
Scrieti un program care:
- citeste numarul de blocuri de date din fisierul text RIV.IN, (fiecare bloc 
contine un set complet de date ale problemei);
- pentru fiecare bloc: 
	- citeste numarul de stalpi si descrierea modului de functionare;
	- calculeaza primul moment posibil in care cetaeanul poate sta pe malul 
drept, daca acest lucru este posibil;
	- scrie rezultatul in fisierul text RIV.OUT.

Intrare
Prima linie a fisierului RIV.IN conine numarul de blocuri de date x, 1<x<5. 
Urmatoarele linii contin cele x blocuri. Primul bloc incepe de pe a doua linie, 
iar fiecare bloc urmeaza imediat dupa cel precedent, fara linie vida.
Prima linie a fiecarui bloc contine un numar intreg n 5<n<1000, reprezentand 
numarul de stalpi.
Fiecare din urmatoarele n linii din bloc contine doua numere intregi a,b separate 
printr-un spaiu, 1<a,b<5. Numerele de pe linia i+1, 1<i<n (din bloc) descriu 
modul de funcionare al stalpului i.

Iesirea
Pentru al k-lea bloc, 1<k<x se scrie un numar intreg pe a k-a linie in fisierul
RIV.OUT, reprezentand primul moment posibil in care cetateanul poate sta pe 
malul drept, sau cuvantul NO daca traversarea nu este posibila.

Exemplu
Pentru fisierul RIV.IN:
2
10
1 1
1 1
1 1
1 1
1 1
1 1
1 1
1 1
1 1
1 1
10
1 1
1 1
1 1
1 1
2 1
1 1
1 1
1 1
1 1
1 1
solutia corecta este:
NO
4

S-au dat 10 teste, fiecare cotat cu cate 3 puncte.
Timp limita per test: 2 sec.
=================================

Solutia 1 (Angel Proorocu - Ploiesti)
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 16384,0,655360}

program TraversareaRaului;

   uses Crt;

   const prim:array[1..11]of byte=(2,3,5,7,11,13,17,19,23,29,31);

   var a,b:array[-5..1006]of byte;
       su,jo:array[-5..1006]of integer;
       n,t:integer;
       f,g:text;

procedure Rezolva;
   var i,j,k,p,cm,nn,au:integer;
   begin
    fillchar(a,sizeof(a),0);
    fillchar(b,sizeof(b),0);
    su[0]:=1000; su[n+1]:=1000;
    jo[0]:=0; jo[n+1]:=0;
    a[0]:=1;
    cm:=1;
    for i:=1 to n do
     begin
      nn:=su[i]+jo[i];
      au:=1;
      for j:=1 to 11 do
       while (cm mod prim[j]=0)and(nn mod prim[j]=0) do
        begin
         au:=au*prim[j];
         cm:=cm div prim[j];
         nn:=nn div prim[j];
        end;
      cm:=cm*nn*au;
     end;
    for k:=1 to cm do
     begin
      for i:=0 to n do if a[i]=1 then
       begin
        for j:=i-5 to i+5 do if b[j]=0 then if su[j]>0 then
         begin
          p:=k mod (su[j]+jo[j]);
          if (p<=su[j])and(p>0) then b[j]:=1;
         end;
       end;
      if b[n+1]=1 then begin writeln(g,k); exit; end;
      a:=b;
      fillchar(b,sizeof(b),0);
     end;
    writeln(g,'NO');
  end;

procedure ReadData;
   var i,j:integer;
   begin
    assign(g,'riv.out');
    rewrite(g);
    assign(f,'riv.in');
    reset(f);
    readln(f,t);
    for i:=1 to t do
     begin
      readln(f,n);
      for j:=1 to n do readln(f,su[j],jo[j]);
      Rezolva;
     end;
    close(f);
    close(g);
   end;

begin
 ReadData;
end.
----------------------------
Solutia 2 (Bogdan Batog - Bucuresti)
var
   fil,fo                       :text;
   x,i,j,f,n,st                 :integer;
   a,b,v1,v2                    :array[0..1001] of integer;

Procedure Solve;
var m,cm:integer;
begin
     m:=0;
     fillchar(v1,2*n+2,0);
     v1[0]:=1;
     a[0]:=1000;
     a[n+1]:=1000;
     b[0]:=0;
     b[n+1]:=0;
     cm:=a[1]+b[1];
     for i:=2 to n do
      if cm mod (a[i]+b[i])<>0 then cm:=cm*(a[i]+b[i]);
     repeat
       fillchar(v2,2*n+2,0);
       inc(m);
       for i:=0 to n+1 do
       if v1[i]=1 then
       begin
        for j:=i-5 to i+5 do
         if (j>=0) and (j<=n+1) and
            (m mod (a[j]+b[j])>=1) and (m mod (a[j]+b[j])<=a[j])
            then v2[j]:=1
       end;
       v1:=v2
     until (v2[n+1]=1) or (m>cm);
     if v2[n+1]=1 then writeln(fo,m) else writeln(fo,'NO')
end;

begin
     assign(fil,'RIV.IN');
     reset(fil);
     assign(fo, 'RIV.OUT');
     rewrite(fo);
     readln(fil,x);
     for st:=1 to x do
     begin
          readln(fil,n);
          for i:=1 to n do readln(fil,a[i],b[i]);
          Solve;
     end;
     close(fil);
     close(fo);
end.
-----------------------------
Solutia 3 (Cristian cadar - Bucuresti)
uses crt;
var
   a,b:array[0..1001] of byte;
   aa,bb:array[1..1000] of byte;
   f:text;
   st:string;
   n,nrset,i,j,k,l,pasi:integer;

function cmmdc(a,b:integer):integer;
var
   r:integer;
begin
     if a<b
        then
            begin
                 r:=a;
                 a:=b;
                 b:=r;
            end;
     r:=a mod b;
     while r<>0 do
        begin
             a:=b;
             b:=r;
             r:=a mod b;
        end;
     cmmdc:=b;
end;

function cmmmc(a,b:integer):integer;
begin
     cmmmc:=a div cmmdc(a,b)*b;
end;

procedure calcul_pasi;
var
   i:integer;
begin
     pasi:=1;
     for i:=1 to n do
         pasi:=cmmmc(pasi,aa[i]+bb[i]);
end;

function sus(i,t:integer):boolean;
var
   k:integer;
begin
     k:=t mod (aa[i]+bb[i]);
     if (k>=1) and (k<=aa[i])
        then sus:=true
        else sus:=false;
end;

procedure prelucrare;
begin
     calcul_pasi;
     fillchar(a,sizeof(a),0);
     a[0]:=1;
     k:=0;
     while (k<pasi) and (a[n+1]=0) do
        begin
             inc(k);
             fillchar(b,sizeof(b),0);
             for i:=0 to n do
                 if a[i]=1
                    then
                        begin
                             for j:=i-5 to i+5 do
                                 if ( (j>0) and (j<n+1) and sus(j,k) )
                                 or (j=0) or (j=n+1)
                                    then b[j]:=1;
                        end;
             a:=b;
        end;
     if a[n+1]=1
        then writeln(k)
        else writeln('NO');
end;

begin
     clrscr;
     write('Fisier intrare:');
     readln(st);
     assign(f,st);
     reset(f);
     readln(f,nrset);
     for l:=1 to nrset do
         begin
              readln(f,n);
              for i:=1 to n do
                  readln(f,aa[i],bb[i]);
              prelucrare;
         end;
     close(f);
end.
----------------------------
Solutia 4 (Adrian carcu - Bistrita Nasaud)
{$Q-,R-,S-,N+,E-}
var fis,fis2:text;
    teste,i,j,n,timp:integer;
    a,b,x,y,z,c:array[0..1001] of integer;
    timer:longint absolute 0:$46c;
    st:longint;

function rezolva:boolean;
var ind,ind2:boolean;
begin
   fillchar(x,sizeof(x),0); x[0]:=1;
   fillchar(y,sizeof(y),0); y[0]:=1; y[n+1]:=1;
   fillchar(z,sizeof(z),0); z[0]:=1;
   for i:=1 to n do c[i]:=a[i];
   timp:=0;
   repeat
      inc(timp); if timp and 15=15 then write(timp,#13);
      ind2:=true;
      for i:=1 to n do begin
         dec(c[i]);
         if c[i]>=0 then y[i]:=1 else y[i]:=0;
         if -c[i]=b[i] then c[i]:=a[i];
         z[i]:=0;
         if c[i]<>a[i] then ind2:=false;
         end;
      for i:=0 to n+1 do if y[i]=1 then begin
         ind:=false;
         for j:=-5 to 5 do if (i+j>=0)and(i+j<=n+1) then
            if x[i+j]=1 then ind:=true;
         if ind then z[i]:=1;
         end;
      x:=z;
   until (x[n+1]=1)or(ind2);
   rezolva:=not ind2;
end;

begin
   st:=timer;
   assign(fis,'riv.in'); reset(fis);
   assign(fis2,'riv.out'); rewrite(fis2);
   readln(fis,teste);
   while teste>0 do begin
      dec(teste);
      readln(fis,n);
      for i:=1 to n do readln(fis,a[i],b[i]);
      if rezolva then writeln(fis2,timp) else writeln(fis2,'NO');
      end;
   close(fis); close(fis2);
   writeln;
   writeln((timer-st)/18.2:0:3);
end.
----------------------------
Solutia 5 (Tudor Leu - Focsani)
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
const ni='riv.in';
      no='riv.out';
var a,b:array[0..1001] of longint;
    x,y:array[0..1001] of boolean;
    cm,r,i,j,k,l,n,p,q:longint;
    sw:boolean;
function sus(stalp,timp:word):boolean;
begin
     if ((timp-1) mod (a[stalp]+b[stalp]))+1<=a[stalp] then sus:=true
                                                       else sus:=false;
end;
function cmmmc(a,b:longint):longint;
var x,y,r:longint;
begin
     x:=a;y:=b;
     repeat
        r:=x mod y;
        x:=y;y:=r;
     until r=0;
     cmmmc:=(a div x)*b;
end;
procedure rezolva;
begin
    cm:=a[1]+b[1];
    for i:=2 to n do cm:=cmmmc(cm,a[i]+b[i]);
    a[0]:=1;b[0]:=0;a[n+1]:=1;b[n+1]:=0;
    k:=1;
    for i:=1 to n+1 do x[i]:=false;
    x[0]:=true;
    repeat
       for i:=0 to n+1 do y[i]:=false;
       for i:=0 to n do
          if x[i] then begin
              if i>4 then j:=i-1
                     else j:=0;
              if i<n-3 then l:=i+5
                       else l:=n+1;
              for r:=j to l do
                 if sus(r,k) then y[r]:=true;
                       end;
       x:=y;
       k:=k+1;
    until (y[n+1]) or (k>cm);
    if y[n+1] then writeln(k-1)
              else writeln('NO');
end;
begin
     assign(input,ni);reset(input);
     assign(output,no);rewrite(output);
     readln(p);
     for q:=1 to p do begin
        readln(n);
        for i:=1 to n do readln(a[i],b[i]);
        rezolva;
     end;
end.
----------------------------
Solutia 6 (Valentin Gheorghita - Ploiesti)
program river_crossing;
var f,g:text;
    nr,x,n:integer;
    numar,time:longint;
    st:array[1..1000,1..2] of integer;
    exista:boolean;

function cmmdc(a,b:longint):longint;
 var c:longint;
 begin
  while (b<>0) and (a<>0) do
   begin
    if b>a then begin
                 c:=a;
                 a:=b;
                 b:=c;
                end;
    a:=a mod b;
   end;
  cmmdc:=b;
 end;

function cmmmc(a,b:longint):longint;
 begin
  cmmmc:=trunc(a/cmmdc(a,b))*b;
 end;

procedure citire;
 var i:integer;
 begin
  numar:=1;
  readln(f,n);
  for i:=1 to n do
   begin
    readln(f,st[i,1],st[i,2]);
    numar:=cmmmc(numar,st[i,1]+st[i,2]);
   end;
 end;

procedure calcul;
 var poz,poznew:array[0..1001] of boolean;
     stalp:array[1..1000,1..3] of integer;
     up:array[0..1001] of boolean;
     pz,i,j:integer;
 begin
  time:=0;
  up[0]:=true;
  up[n+1]:=true;
  fillchar(poz,sizeof(poz),false);
  poz[0]:=true;
  for i:=1 to n do
   begin
    stalp[i,1]:=1;
    stalp[i,2]:=st[i,1];
    stalp[i,3]:=st[i,2];
   end;
  while not(poz[n+1]) and exista do
   begin
    for i:=1 to n do
     begin
      if stalp[i,1]=1 then begin
                            if stalp[i,2]=0 then begin
                                                  up[i]:=false;
                                                  stalp[i,1]:=2;
                                                  stalp[i,2]:=st[i,1];
                                                  stalp[i,3]:=stalp[i,3]-1;
                                                 end
                                            else begin
                                                  up[i]:=true;
                                                  stalp[i,2]:=stalp[i,2]-1;
                                                 end;
                           end
                      else begin
                            if stalp[i,3]=0 then begin
                                                  up[i]:=true;
                                                  stalp[i,1]:=1;
                                                  stalp[i,3]:=st[i,2];
                                                  stalp[i,2]:=stalp[i,2]-1;
                                                 end
                                            else begin
                                                  up[i]:=false;
                                                  stalp[i,3]:=stalp[i,3]-1;
                                                 end;
                           end;
     end;
    for i:=0 to n+1 do
     poznew[i]:=false;
    for i:=0 to n+1 do
     if poz[i] then
     for j:=-5 to 5 do
      begin
       pz:=i+j;
       if (pz>=0) and (pz<=n+1) then
        if up[pz] then poznew[pz]:=true;
      end;
    time:=time+1;
    poz:=poznew;
    if time>numar then exista:=false;
   end;
 end;

procedure tiparire;
 begin
  if exista then writeln(g,time)
            else writeln(g,'NO');
 end;

begin
 assign(f,'riv.in');
 reset(f);
 assign(g,'riv.out');
 rewrite(g);
 readln(f,x);
 for nr:=1 to x do
  begin
   exista:=true;
   citire;
   calcul;
   tiparire;
  end;
 close(f);
 close(g);
end.
------------------------------
Solutia 7 (Virgil Serbanuta - Focsani)
var si,si1,si2:array[-5..1005] of byte;
    ab:array[1..1000] of record
                      a,b,c:byte;
                      end;
    n,z,x,np,i:word;

procedure citire;
var i,j,k:word;
begin
readln(n);
fillchar(si1,sizeof(si1),0);
for i:=1 to n do begin
    readln(ab[i].a,ab[i].b);
    ab[i].c:=1;{jos}
    si[i]:=ab[i].b;
    end;
si1[0]:=1;
z:=1;
np:=0;
end;

procedure next_step;
var i,j:integer;
begin
z:=0;
fillchar(si2,sizeof(si2),0);
si2[0]:=1;
for i:=1 to n do begin
    inc(si[i]);
    if ab[i].c=1 then
       if si[i]>ab[i].b then
          begin
          si[i]:=1;
          ab[i].c:=0;
          end
          else else
       if si[i]>ab[i].a then
          begin
          si[i]:=1;
          ab[i].c:=1;
          end;
    if ab[i].c=0 then
       for j:=-5 to 5 do
           if si1[i+j]=1 then
              begin
              si2[i]:=1;
              break;
              end;
    z:=z+ab[i].c;
    end;
for j:=-4 to 0 do
    if si1[n+j]=1 then
       begin
       si2[n+1]:=1;
       break;
       end;
si1:=si2;
end;

begin
assign(input,'riv.in');
reset(input);
assign(output,'riv.out');
rewrite(output);
readln(x);
for i:=1 to x do
    begin
    citire;
    while (z<n) and (si1[n+1]=0) do
          begin
          next_step;
          inc(np);
          end;
    if si1[n+1]=1 then
       writeln(np)
       else writeln('NO');
    end;
end.
--------------------------
Solutia 8 (Mihai Stroe - Bucuresti)
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 65520,0,655360}

type ar=array[0..1001]of byte;
var t1,t2:array[0..1001]of word;
    a,b,p:^ar;
    fi,fo:text;
    i,j,k,l,m,n,x,y:longint;

procedure readdata;
begin
  readln(fi,n);
  for i:=1 to n do
      readln(fi,t1[i],t2[i]);
  t1[0]:=1;
  t2[0]:=0;
  t1[n+1]:=1;
  t2[n+1]:=0;
end;

function ghinion:boolean;
begin
  if m<=2520 then ghinion:=false else ghinion:=true;
  exit;
  if m=0 then exit;
  ghinion:=true;
  for i:=1 to n do
      if a^[i]<>0 then
         begin
           ghinion:=false;
           exit;
         end;
end;

procedure nextmove;
begin
  fillchar(b^,sizeof(b^),0);
  for i:=0 to n+1 do
      if a^[i]<>0 then
         for j:=-5 to 5 do
             if (i+j>=0)and(i+j<=n+1)then
                if (m)mod(t1[i+j]+t2[i+j])in [0..t1[i+j]-1] then
                      begin
                        b^[i+j]:=1;
                      end;
  p:=a;
  a:=b;
  b:=p;
  inc(m);
end;

procedure solve;
begin
  fillchar(a^,sizeof(a^),0);
  m:=0;
  a^[0]:=1;
  while not ghinion do
    begin
      nextmove;
      if a^[n+1]<>0 then
         begin
           writeln(fo,m);
           exit;
         end;
    end;
  writeln(fo,'NO');
end;

begin
  new(a);
  fillchar(a^,sizeof(a^),0);
  new(b);
  assign(fi,'riv.in');
  assign(fo,'riv.out');
  reset(fi);
  rewrite(fo);
  readln(fi,x);
  for y:=1 to x do
      begin
        readdata;
        solve;
      end;
  close(fi);
  close(fo);
end.
-------------------------------
